home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0027_Fast Anagrams.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  2.5 KB  |  113 lines
  1. {$A+,B+,D+,E-,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T+,V-,X+,Y+}
  2. {$M 65520,100000,655360}
  3. {
  4.   Copyright 1993 Mark Ouellet. All rights reserved.
  5.  
  6.   May be freely distributed and incorporated in your own code, in part
  7.   or in it's entirety as long as due credit is given to it's author
  8.  
  9.   All I ask is that you state my name if you use ALL or PART of it in
  10.   your own code.
  11. }
  12.  
  13. Program FastAnagrams;
  14.  
  15. Uses
  16.   Crt;
  17.  
  18. Type
  19.   StrPointer = ^String;
  20.   NodePtr = ^Node;
  21.   Node    = Record
  22.     Anagram : StrPointer;
  23.     Next    : NodePtr;
  24.   end;
  25.  
  26. Var
  27.   OldAnagrams : NodePtr;
  28.   NewAnagrams : NodePtr;
  29.   OldCursor : NodePtr;
  30.   NewCursor : NodePtr;
  31.   InputStr : String;
  32.  
  33. Procedure GetInput;
  34. begin
  35.   ClrScr;
  36.   Write('Input your String: ');
  37.   readln(InputStr);
  38. end;
  39.  
  40. Procedure FindAnagrams;
  41.  
  42. Var
  43.   OldIndex : Word;
  44.   NewIndex : Word;
  45.  
  46. begin
  47.   OldAnagrams := NIL;
  48.   OldCursor   := NIL;
  49.   NewAnagrams := NIL;
  50.   NewCursor   := NIL;
  51.  
  52.   New(OldCursor);
  53.   OldCursor^.Next := OldAnagrams;
  54.   GetMem(OldCursor^.Anagram, 2);
  55.   OldCursor^.Anagram^ := Copy(InputStr, 1, 1);
  56.   OldAnagrams := OldCursor;
  57.  
  58.   For OldIndex := 2 to Ord(InputStr[0]) do
  59.   begin
  60.     OldCursor := OldAnagrams;
  61.     While OldCursor <> NIL do
  62.     begin
  63.       For NewIndex := 1 to Ord(OldCursor^.Anagram^[0])+1 do
  64.       begin
  65.         New(NewCursor);
  66.         NewCursor^.Next := NewAnagrams;
  67.         getmem(NewCursor^.Anagram, sizeof(OldCursor^.Anagram^)+1);
  68.         NewCursor^.Anagram^ := OldCursor^.Anagram^;
  69.         Insert(Copy(InputStr, OldIndex, 1),
  70.           NewCursor^.Anagram^, NewIndex);
  71.         NewAnagrams := NewCursor;
  72.       end;
  73.       OldCursor := OldCursor^.Next;
  74.       FreeMem(OldAnagrams^.Anagram, Ord(OldAnagrams^.Anagram^[0])+1);
  75.       OldAnagrams^.Anagram := nil;
  76.       Dispose(OldAnagrams);
  77.       OldAnagrams := OldCursor;
  78.     end;
  79.     OldAnagrams := NewAnagrams;
  80.     OldCursor   := OldAnagrams;
  81.     NewAnagrams := NIL;
  82.     NewCursor   := NIL;
  83.   end;
  84. end;
  85.  
  86. Procedure OutputAnagrams;
  87. Var
  88.   Count : Word;
  89. begin
  90.   Count := 0;
  91.   OldCursor := OldAnagrams;
  92.   While OldCursor <> NIL do
  93.   begin
  94.     OldCursor := OldCursor^.Next;
  95.     Writeln(OldAnagrams^.Anagram^);
  96.     FreeMem(OldAnagrams^.Anagram, sizeof(OldAnagrams^.Anagram^));
  97.     dispose(OldAnagrams);
  98.     OldAnagrams := OldCursor;
  99.     Inc(Count);
  100.   end;
  101.   Writeln;
  102.   Writeln(Count, ' Anagrams found.');
  103. end;
  104.  
  105. begin
  106.   GetInput;
  107.   Writeln;
  108.   Writeln(MaxAvail, ' Available memory.');
  109.   Writeln;
  110.   FindAnagrams;
  111.   OutputAnagrams;
  112. end.
  113.